home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
win_utl2
/
wasted16.zip
/
WASTED.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-05-17
|
19KB
|
438 lines
{ WASTED.EXE - Version 1.6 }
{ Created: 05/17/1996 }
{ Writen by Tim Jones }
{ tjones@wpogate.ssc.nasa.gov }
{$M 32767,0,655360} {set up a large stack for recursion}
Program wasted;
uses
dos; {for things like findfirst/findnext, intr() etc.}
const
version='1.6'; {current version of the program}
fspec='*.*'; {could be changed to be a user input ex. *.exe}
lastrptm=2; {number of report methods in the program}
var
param:string; {holding variable for each cmd-line parameter}
startDir,origDir:string; {dir to start checking at and the dir we are in}
totclust:longint; {total number of clusters on the disk}
clust,usrclust:longint; {cluster size, user cluster size}
totalbs:longint; {total bytesize for all directories}
totalrs:longint; {total realsize for all directories}
regs:registers; {variable for holding DOS Interrupt registers}
i:byte; {loop variable}
fcount:byte; {# of files specified on the cmd-line}
sdrive:byte; {source drive in numerical format A=1, B=2 etc.}
s1name,source:dirstr; {user specified dir and actual dir to be used}
sdir:dirstr; {pieces parts for the split source dir}
sname:namestr; {pieces parts for the split source dir(not used)}
sext:extstr; {pieces parts for the split source dir(not used)}
error:integer; {string to numeric conversion error flag}
showtotals:boolean; {holds user choice for showing totals or not}
pause:boolean; {holds user choice for screen pausing}
linecount:byte; {holds the number of screen lines displayed}
quitit:boolean; {if quitit is true then the program will end}
usrrptm:integer; {user specified report method}
tmp:string; {used to hold numbers for conversion to strings}
{This function will convert a given string into an all upper case string}
function upper(s:string):string;
var
i:Integer;
begin
for i := 1 to Length(s) do
s[i] := UpCase(s[i]);
upper:=s;
end;
{This function will "pad right" a string to a given length with a given char.}
function padr(s:string; l:integer; c:char):string;
begin
while length(s) < l do
begin
s:=s+c;
end;
padr:=s;
end;
{This function will return the left portion of a string (chars 1 to p)}
function left(s:string; p:integer):string;
begin
if p > 0 then
delete(s, p+1, length(s)-p)
else
s:='';
left:=s;
end;
{This function will return the right portion of a string (chars strlen to p)}
function right(s:string; p:integer):string;
begin
if p > 0 then
delete(s, 1, length(s)-p)
else
s:='';
right:=s;
end;
{This function invokes DOS interrupt 21h function 1Ch to return the cluster}
{size for the given drive}
{bytedrv = numerical equivalent of the drive letter A=0, B=1, C=2 etc.}
function getClustSize(bytedrv:byte):word;
var
regs:registers;
begin
regs.AH:=$1C; {Call to Get FAT info}
regs.DL:=bytedrv; {function 1C expects A=1, B=2, C=3 etc.}
intr($21,regs); {perform actual interrupt call}
getClustSize:=regs.al*regs.cx; {calculate/return cluster size}
end;
{This function invokes DOS interrupt 21h function 36h to return the number}
{of used clusters on the given drive}
{bytedrv = numerical equivalent of the drive letter A=0, B=1, C=2 etc.}
function getTotalClust(bytedrv:byte):word;
var
regs:registers;
begin
regs.AH:=$36; {Call to Get Free Disk Space}
regs.DL:=bytedrv; {function 36 expects A=1, B=2, C=3 etc.}
intr($21,regs); {perform actual interrupt call}
getTotalClust:=regs.dx; {calculate/return no. of used clusters}
end;
{This function will make sure that the given directory has at least one}
{directory specified and will chop off the trailing backslash if needed}
{This function was necessary because the pascal CHDIR() function does not}
{appear to work properly. ex. chdir('C:\') works but chdir('C:\BP\BIN\')}
{does not work. (go figure)}
function dir(sdir:string):string;
begin
if right(sdir,1)='\' then {check for an ending backslash}
begin
sdir:=left(sdir, length(sdir)-1); {remove the ending backslash}
if right(sdir,1)=':' then {check for the case of "C:\"}
sdir:=sdir+'\'; {put the ending backslash back on}
end;
dir:=sdir; {return the new directory}
end;
{This procedure will display the syntax for the program and also display an}
{error message if one was supplied. This procedure always halts the program}
{with an error level 0 (no error) or 1 (error)}
procedure syntax(errmsg:string);
begin
writeln(' Purpose:');
writeln(' WASTED was written to quickly traverse a harddrive and report');
writeln(' how much diskspace each directory really uses based upon the');
writeln(' cluster size.');
writeln(' Output:');
writeln(' dirbytes usedbytes usedbytes-dirbytes percentage');
writeln(' where percentage is based upon the report method used. (see below)');
writeln(' Syntax:');
writeln(' WASTED [directory] [parameters]');
writeln(' where directory is the directory to start at (default=current directory)');
writeln(' Parameters: (prefix / and - are valid)');
writeln(' /? = This help text');
writeln(' /C:n = Sets the cluster size to n (where n > 0)');
writeln(' /NT = Turns off the displaying of the Total line (No Totals)');
writeln(' /P = Pause between screens');
writeln(' /R:n = Report using method n');
writeln(' n=1 = Wasted percentage based upon disk size (default)');
writeln(' n=2 = Wasted percentage based upon used disk space');
writeln(' optional parameters may be specified in any order');
writeln;
if errmsg <> '' then
begin
writeln;
writeln('Error: '+errmsg);
halt(1);
end;
halt(0);
end;
{This function takes a given drive/directory and figures out the cluster info}
function init(startdir:string):string;
var
source:string[80];
begin
{generate the source drive (default = current drive\dir)}
if right(startdir,1)<>'\' then startdir:=startdir+'\'; {append an ending \}
source:=fexpand(startdir); {expands the dir to a fully qualified dir}
fsplit(source,sdir,sname,sext); {splits the dir into pieces parts}
sdrive:=ord(upcase(sdir[1]))-64; {store the source drive as a number A=1}
clust:=getClustSize(sdrive); {store the cluster size}
totclust:=getTotalClust(sdrive); {store the total number of clusters}
if usrclust > 0 then {if the user specified a cluster size...}
begin
{calc how many user clusters will fit on the drive}
totclust:=(totclust*clust) div usrclust;
clust:=usrclust; {use the users cluster size}
end;
totalbs:=0; {initialize the total bytesize}
totalrs:=0; {initialize the total realsize}
linecount:=0; {initialize the number of lines displayed}
quitit:=false; {allow recursion to start}
init:=sdir; {return the drive/dir we just got info on}
end;
{This function invokes DOS interrupt 21h function 07h to wait for user input}
{from STDIN. The reason I just didn't use Pascal's Readkey or Keypressed}
{functions is because if you include the CRT unit, then you cannot perform}
{redirection of output on the dos commandline ex. WASTED C:\ > FULLDISK.TXT}
function dosPause:byte;
var
regs:registers;
begin
regs.AH:=$07; {Call to Direct STDIN Input function}
intr($21,regs); {perform actual interrupt call}
if regs.AL = $1B then {check for ESC key}
quitit:=true; {set flag to break out of recursion loop}
end;
procedure checkpause(lines:byte);
var
k:char;
begin
if pause = true then
begin
if linecount+lines > 23 then
begin
dospause;
linecount:=0;
end;
linecount:=linecount+lines;
end;
end;
{This procedure will calculate the amount of wasted space taken up by the}
{files in the current directory}
procedure calcWaste(fspec:string);
var
dirinfo:searchrec; {search record for findfirst/findnext functions}
bytesize:longint; {combined byte size of the files as reported by DOS}
realsize:longint; {combined byte size of the files based upon clusters}
begin
bytesize:=0; {initialize byte size of the files as reported by DOS}
realsize:=0; {initialize byte size of the files based upon clusters}
findfirst(fspec,hidden+readonly+sysfile+archive,dirinfo);
while doserror = 0 do {while files exist in the dir}
begin
bytesize:=bytesize+dirinfo.size; {add byte sizes}
realsize:=realsize+((dirinfo.size div clust)*clust); {add clust sizes}
if dirinfo.size mod clust > 0 then {if file partly fills a clust}
realsize:=realsize+clust; {add a whole clust}
findnext(dirinfo); {find the next file}
end;
if (totclust = 0) or (bytesize = 0) then
begin
{display the line for this directory (this is to avoid div by 0 case)}
writeln(bytesize:10,' ',realsize:10,' ',realsize-bytesize:10,' ',0.0:6:2,'%');
end else
begin
{display the line for this directory}
case usrrptm of
1:writeln(bytesize:10,' ',realsize:10,' ',realsize-bytesize:10,' ',((((realsize-bytesize)/clust)/totclust)*100):6:2,'%');
2:writeln(bytesize:10,' ',realsize:10,' ',realsize-bytesize:10,' ',100*((realsize-bytesize)/realsize):6:2,'%');
end; {case}
end;
totalbs:=totalbs+bytesize; {add this directory bytesize to the total}
totalrs:=totalrs+realsize; {add this directory realsize to the total}
end;
{This procedure will display the dir we are working on, calculate the space}
{being wasted in that dir, and finally, recurse into any subdirectories}
procedure showWasted(theDir:string);
var
nextDir:string; {var to hold the next dir before recursing into it}
dirinfo2:searchrec; {searchrec for findfirst/findnext}
begin
if length(theDir) > 39 then
checkpause(2) {add 2 to linecount for long directories}
else checkpause(1); {add 1 to the linecount and check for pause}
write(padr(theDir,39,' ')); {display the current dir}
calcwaste(fspec); {calculate and display wasted space}
{find the first subdir in this dir}
findfirst(fspec,hidden+sysfile+readonly+archive+directory,dirinfo2);
while (quitit = false) and (doserror = 0) do {while no ESC key and a file was found (no error)}
begin
if dirinfo2.attr and directory = directory then {if the file found is a directory...}
begin
nextDir:=dirinfo2.name; {store the name as the next dir to recurse}
{only recurse non . and .. directories}
if (nextDir <> '.') and (nextDir <> '..') then
begin
nextDir:=fexpand(nextDir); {expand the next dir for display later}
ChDir(nextDir); {change into the next directory}
showWasted(nextDir); {call this procedure(showWasted) recursivly}
ChDir('..'); {change back to this directory}
end;
end;
findnext(dirinfo2); {find the next file/directory}
end;
end;
{This procedure will display some initial stats and spawn off the initial}
{call to the recursion procedure}
{Munge, munj, n. To process information; think; muttle over.}
procedure munge;
begin
GetDir(0,origDir); {find where we are on the drive so we can come back}
if s1name <> '' then {if the user specified a starting point...}
startDir:=init(s1name) {init drive info for the users drive}
else
startDir:=init(origDir); {init drive info for the current drive}
{display cluster info and column headers}
writeln('Cluster size : ',clust:10);
writeln('# of Clusters : ',totclust:10);
writeln('Est. Disk Size: ',totclust*clust:10);
writeln('Directory Bytesize Realsize Wasted');
linecount:=6;
{$I-}
ChDir(dir(startDir)); {go into the starting directory}
if IOResult = 3 then syntax('Path not found: '+startDir);
{$I+}
showWasted(startDir); {display wasted space in this dir and its subdirs}
if showtotals = true then {display the total line if the user hasn't specified otherwise}
begin
write('Total: ');
if (totclust = 0) or (totalbs = 0) then
begin
{display the line for this directory (this is to avoid div by 0 case)}
writeln(totalbs:10,' ',totalrs:10,' ',totalrs-totalbs:10,' ',0.0:6:2,'%');
end else
begin
{display the line for this directory}
case usrrptm of
1:writeln(totalbs:10,' ',totalrs:10,' ',totalrs-totalbs:10,' ',((((totalrs-totalbs)/clust)/totclust)*100):6:2,'%');
2:writeln(totalbs:10,' ',totalrs:10,' ',totalrs-totalbs:10,' ',100*((totalrs-totalbs)/totalrs):6:2,'%');
end; {case}
end;
end;
ChDir(origDir); {go back to where we originally started from}
end;
begin
{display the program name, version, and author(s)}
writeln;
writeln('WASTED.EXE v',version,' - written by Tim Jones');
writeln;
fcount:=0; {set file counter to zero}
usrclust:=0; {set user defined clustersize to 0}
{change the usrrptm value to a 2 to make the second report method the default}
usrrptm:=1; {set the report method to 1 (default)}
showtotals:=true; {set the flag to show the totals}
tmp:=''; {init the tmp number holder}
for i:=1 to paramcount do {loop through each command-line parameter}
begin
param:=upper(paramstr(i)); {store off the current parameter in uppercase}
if (left(param,1) = '/') or (left(param,1) = '-') then {is it an option?}
begin
case param[2] of {check the second character of the parameter}
'?':syntax(''); {help text}
'C':begin {user specified cluster size}
{check for a colon separater and report any error}
if param[3] <> ':' then syntax('Unknown parameter:'+param);
{convert what follows the colon into a number}
val(right(param, length(param)-3), usrclust, error);
if error <> 0 then {if the convertion faild...}
begin
{display the conversion error and quit}
syntax('Numeric conversion error in parameter:'+param);
end;
if usrclust <= 0 then {if the cluster size is <=0...}
begin
{display the cluster size error and quit}
syntax('Cluster size must be >= 0');
end;
end;
'N':begin {No Totals parameter?}
{check for a 'T'}
if param[3] <> 'T' then syntax('Unknown parameter:'+param);
showtotals:=false; {turn off the showing of end totals}
end;
'P':begin {Pause screen listing}
pause:=true; {turn on the pausing between screenfulls}
end;
'R':begin {report method was specified}
{check for a colon separater and report any error}
if param[3] <> ':' then syntax('Unknown parameter:'+param);
{convert what follows the colon into a number}
val(right(param, length(param)-3), usrrptm, error);
if error <> 0 then {if the convertion faild...}
begin
{display the conversion error and quit}
syntax('Numeric conversion error in parameter:'+param);
end;
if usrrptm <= 0 then {if the report method is <=0...}
begin
{display the report method error and quit}
syntax('Report method must be >= 0');
end;
if usrrptm > lastrptm then {if the report method is too high...}
begin
{display the report method error and quit}
str(lastrptm,tmp); {convert numeric report method to string}
syntax('Report method must be <= '+tmp);
end;
end;
else
{the user specified an unknown parameter so display error and quit}
syntax('Unknown parameter:'+param);
end; {case}
end else
begin
{the user must have specified a filename / directory}
fcount:=fcount+1;
case fcount of {this case stmt is here for future expansion}
1: s1name:=param; {source 1 name = user specified starting directory}
else
{only one file parameter is allowed, display error and quit}
syntax('Too many file parameters:'+param);
end;
end;
end;
munge; {let's go!!!}
end.
{Program History:
v1.0 - first (non public) release limited to 4096 byte cluster size
v1.1 + added auto calculating of cluster size
- changed wasted percentage to be percentage of used disk space
v1.2 - changed wasted percentage to be percentage of total disk space
- previous versions were fixed to C:
+ added ability to start from any directory
v1.3 - first public release
- completely re-worked the checking of commandline parameters
- fixed a bug which ended the recursion early
+ added help/syntax screen
+ added /? option for display of help/syntax screen
+ added /C:n option to allow the user to change the cluster size
+ added this history list
v1.4 - fixed a bug which causes Runtime Error 003 (path not found) when
you are in a subdirectory and did not specify a starting directory.
+ now you can specify paths with or without the trailing backslash
+ added a Total line at the end (default is to show totals)
+ added the switch /NT to disable the showing of totals
+ added the switch /P to enable a pause between screenfulls of info
v1.5 + added the switch /R:n to allow the user to select the method
for calculating the wasted percentage
n=1 = Wasted percentage based upon disk size (default)
n=2 = Wasted percentage based upon used disk space
+ added more information to the documentation file
v1.6 - the program will now recurse into hidden subdirectories
+ recompiled to produce a smaller EXE (almost half the original size!)
}
